MacFormat 1995 May/macformat-024.iso/Shareware City/Developers/TransSkel Pascal 2.5/TransSkel/MultiSkel ƒ/MSkelRgn.p

Text File | 1994-12-12 | 5.2 KB | 218 lines | [TEXT/PJMM]

{    TransSkel multiple-window demonstration: Region module}

{    This module handles a window in which the mouse may be clicked and}
{    dragged to draw rectangles.  The rects so drawn are combined into}
{    a single region, the outline of which is drawn.  Rects drawn while}
{    the shift key is held down are subtracted from the region.}
{    Double-clicking the mouse clears the display.  If the window is}
{    resized, the region that is drawn is resized as well.}

{    14 June 1986        Paul DuBois}

{    Changes:}
{    07/08/86 Changed outline so that it's drawn as a marquee.}
{    Ported to LightSpeed Pascal 7 January 1987                    }
{    By Owen Hartnett, Ωhm Software                                }
{    30 December 1987 OH changed to support version 1.03 }

unit MSkelRgn;
interface

    uses
{$IFC UNDEFINED THINK_PASCAL}
        Memtypes, Quickdraw, OSIntf, ToolIntf, PackIntf,
{$ENDC}
        transSkel, multiSkelGlobals, common;

    procedure RgnWindInit;


implementation

    var
        rgnPortRect: Rect;    { portRect size - for detecting wind grows }
        selectRgn: RgnHandle;        { current region to be drawn }
        selectWhen: longint;        { time of last click }
        selectWhere: Point;    { location of last click }
        marqueePat: Pattern;

    procedure Clobber;

    begin
        DisposeRgn(selectRgn);
        CloseWindow(rgnWind);
    end;

{    While mouse is down, draw gray selection rectangle in the current}
{    port.  Return the resultant rect in dstRect.  The rect is always}
{    clipped to the current portRect.}


    procedure DoSelectRect (startPoint: point; var dstRect: Rect);

        var
            pt, dragPt: Point;
            rClip: Rect;
            thePort: GrafPtr;
            result: Boolean;
            ps: PenState;
            i: integer;

    begin
        GetPort(thePort);
        rClip := thePort^.portRect;
        rClip.right := rClip.right - 15;
        GetPenState(ps);
{$IFC UNDEFINED THINK_PASCAL}
        PenPat(qd.gray);
{$ELSEC}
        PenPat(gray);
{$ENDC}
        PenMode(patXor);
        dragPt := startPoint;
        Pt2Rect(dragPt, dragPt, dstRect);
        FrameRect(dstRect);
        while StillDown do
            begin
                GetMouse(pt);
                if not EqualPt(pt, dragPt) then    { mouse has moved, change region }
                    begin
                        FrameRect(dstRect);
                        dragPt := pt;
                        Pt2Rect(dragPt, startPoint, dstRect);
                        result := SectRect(dstRect, rClip, dstRect);
                        FrameRect(dstRect);
                        for i := 0 to 1000 do
                            ;
                    end;
            end;
        FrameRect(dstRect);    { erase last rect }
        SetPenState(ps);
    end;

    procedure MarqueeRgn (r: RgnHandle);

        var
            p: PenState;
            b: Byte;
            i: integer;

    begin
        GetPenState(p);
        PenPat(marqueePat);
        PenMode(patCopy);
        FrameRgn(r);
        SetPenState(p);
        b := marqueePat[0];        { shift pattern for next call }
        for i := 0 to 6 do
            marqueePat[i] := marqueePat[i + 1];
        marqueePat[7] := b;
    end;

    procedure Idle;

        var
            i: integer;

    begin
        SetWindClip(rgnWind);
        MarqueeRgn(selectRgn);    { draw selection region outline }
        ResetWindClip;            { restore previous clipping }
    end;

{    On double-click, clear window.  On single click, draw gray selection}
{    rectangle as long as mouse is held down.  If user draws non-empty rect,}
{    then add it to the selection region and redraw the region's outline.}
{    If the shift-key was down, then subtract the selection region instead}
{    and redraw.}


    procedure Mouse (thePt: Point; t: longint; mods: integer);

        var
            r: Rect;
            rgn: RgnHandle;

    begin
        r := rgnWind^.portRect;
        if thePt.h < r.right - 15 then        { must not click in right edge }
            begin
                if (t - selectWhen <= GetDblTime) then    { it's a double-click }
                    begin
                        selectWhen := 0;        { don't take next click as dbl-click }
                        SetWindClip(rgnWind);
                        EraseRgn(selectRgn);
                        ResetWindClip;
                        SetEmptyRgn(selectRgn);    { clear region }
                    end
                else
                    begin
                        selectWhen := t;                { update click variables }
                        selectWhere := thePt;
                        DoSelectRect(thePt, r);    { draw selection rectangle }
                        if not EmptyRect(r) then
                            begin
                                EraseRgn(selectRgn);
                                selectWhen := 0;
                                rgn := NewRgn;
                                RectRgn(rgn, r);
                                if (Bitand(mods, shiftKey)) <> 0 then        { test shift key }
                                    DiffRgn(selectRgn, rgn, selectRgn)
                                else
                                    unionRgn(selectRgn, rgn, selectRgn);
                                DisposeRgn(rgn);
                            end;
                    end;
            end;
    end;

{    Redraw the current region.  If the window was resized, resize}
{    the region to fit.}

    procedure Update (resized: Boolean);

        var
            r: Rect;

    begin
        EraseRect(rgnWind^.portRect);
        if resized then
            begin
                r := rgnWind^.portRect;
                rgnPortRect.right := rgnPortrect.right - 15;    { don't use right edge of window }
                r.right := r.right - 15;
                MapRgn(selectRgn, rgnPortRect, r);
                rgnPortRect := rgnWind^.portRect
            end;
        DrawGrowBox(rgnWind);
        idle;
    end;

    procedure Activate (active: Boolean);

    begin
        DrawGrowBox(rgnWind);
        if active then
            DisableItem(editMenu, 0)
        else
            EnableItem(editMenu, 0);
        DrawMenuBar;
    end;

    procedure RgnWindInit;

    begin
        StuffHex(@marqueePat, '0f87c3e1f0783c1e');
        rgnWind := GetNewWindow(rgnWindRes, nil, WindowPtr(-1));
        dummy := SkelWindow(rgnWind, @Mouse, nil, @update, @activate, nil, @Clobber, @Idle, true);
        { ignore keyclicks }
        { no close proc }
    { disposal proc }
        { idle proc }

        rgnPortRect := rgnWind^.portRect;
        selectRgn := NewRgn;    { selected region empty initially }

        selectWhen := 0;    { first click can't be taken as dbl-click }
    end;
end.